home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / QROMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  40 lines
  1. PROCEDURE qromo(a,b: real; VAR ss: real);
  2. (* Programs using routine QROMO must define the type
  3. TYPE
  4.    glnarray = ARRAY [1..n] OF real;
  5. in the main routine, where n is equal to the constant k below. The routine
  6. func(x:real):real in the calling routine must return the value of the function
  7. to be integrated.  You must choose MIDPNT, MIDSQL, MIDSQU or MIDINF at the
  8. indicated point below *)
  9. LABEL 99;
  10. CONST
  11.    eps=1.0e-6;
  12.    jmax=14;
  13.    jmaxp=15;   (* jmaxp=jmax+1 *)
  14.    k=5;
  15.    km=4;      (* km=k-1 *)
  16. VAR
  17.    i,j: integer;
  18.    dss: real;
  19.    h,s: ARRAY [1..jmaxp] OF real;
  20.    c,d: glnarray;
  21. BEGIN
  22.    h[1] := 1.0;
  23.    FOR j := 1 TO jmax DO BEGIN
  24. (* Here you must choose the appropriate integration method *)
  25.       midsql(a,b,s[j],j);
  26.       IF  (j >= k)  THEN BEGIN
  27.          FOR i := 1 TO k DO BEGIN
  28.             c[i] := h[j-k+i];
  29.             d[i] := s[j-k+i]
  30.          END;
  31.          polint(c,d,k,0.0,ss,dss);
  32.          IF (abs(dss) < (eps*abs(ss))) THEN GOTO 99
  33.       END;
  34.       s[j+1] := s[j];
  35.       h[j+1] := h[j]/9.0
  36.    END;
  37.    writeln('pause in QROMO - too many steps');
  38.    readln;
  39. 99: END;
  40.